home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Input 64
/
Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64
/
macros .lsp
< prev
next >
Wrap
Text File
|
2023-02-26
|
3KB
|
99 lines
(expand expr (lambda nil (setq
macro-expansion t)))
(no-expand expr (lambda nil (setq
macro-expansion nil)))
(macro-expansion value t)
(for macro (nlambda l (replace l (
prog (var von nach count-fn test-fn) (
setq var (cadr l)) (setq von (eval (
car (cddr l)))) (setq nach (eval (
cadr (cddr l)))) (cond ((greaterp von
nach) (setq test-fn (quote lessp)) (
setq count-fn (quote sub1))) (t (setq
test-fn (quote greaterp)) (setq
count-fn (quote add1)))) (return (
list (quote prog) (list var) (list (
quote setq) var von) (quote loop) (
list (quote cond) (list (list test-fn
var nach) (quote (return nil))) (cons
(quote t) (cddr (cddr l)))) (list (
quote setq) var (list count-fn var)) (
quote (go loop))))))))
(selectq macro (nlambda l (replace l (
cons (quote cond) ((label selectq1 (
lambda (x l) (cond ((atom (cdr l)) (
list (list (quote t) (car l)))) (t (
cons (cons (list (cond ((atom (caar l)
) (quote eq)) (t (quote member))) x (
list (quote quote) (caar l))) (cdar l)
) (selectq1 x (cdr l))))))) (cadr l) (
cddr l))))))
(replace expr (lambda (x y) (cond (
macro-expansion (rplaca x (car y)) (
rplacd x (cdr y))) (t y))))
(if macro (mlambda l (replace l (list
(quote cond) (list (cadr l) (car (
cddr l))) (cons (quote t) (cdr (cddr
l)))))))
(while macro (mlambda l (replace l (
list (quote prog) nil (quote loop) (
list (quote cond) (list (list (quote
not) (cadr l)) (list (quote return)
nil)) (cons (quote t) (cddr l))) (
quote (go loop))))))
(repeat macro (mlambda l (replace l (
list (quote prog) (quote (n)) (list (
quote setq) (quote n) (eval (cadr l)))
(quote loop) (list (quote cond) (
list (quote (zerop n)) (quote (return
nil))) (cons (quote t) (cddr l))) (
quote (setq n (sub1 n))) (quote (go
loop))))))
(let macro (mlambda l (replace l (
cons (cons (quote lambda) (cons (
mapcar (quote car) (cadr l)) (cddr l))
) (mapcar (quote cadr) (cadr l))))))
(local macro (mlambda l (replace l (
cons (cons (quote lambda) (cdr l))
nil))))
(incr macro (mlambda l (replace l (
list (quote setq) (cadr l) (list (
quote add1) (cadr l))))))
(decr macro (mlambda l (replace l (
list (quote setq) (cadr l) (list (
quote sub1) (cadr l))))))
(push macro (nlambda l (replace l (
list (quote setq) (cadr l) (list (
quote cons) (car (cddr l)) (cadr l))))
))
(pop macro (nlambda l (replace l (
list (quote prog1) (list (quote car) (
cadr l)) (list (quote setq) (cadr l) (
list (quote cdr) (cadr l)))))))
(mcons macro (nlambda l (replace l (
cond ((atom (cddr l)) (cadr l)) (t (
list (quote cons) (cadr l) (cons (
quote mcons) (cddr l))))))))
(ncons macro (nlambda l (replace l (
list (quote cons) (cadr l) nil))))
(xcons macro (nlambda l (replace l (
list (quote cons) (car (cddr l)) (
cadr l)))))
(function macro (nlambda l (replace l
(list (quote quote) (cadr l)))))
(f:l macro (nlambda l (replace l (
list (quote quote) (cons (quote
lambda) (cdr l))))))
(q:l macro (nlambda l (replace l (
list (quote quote) (cons (quote
lambda) (cdr l))))))
(neq macro (nlambda l (replace l (
list (quote not) (list (quote eq) (
cadr l) (car (cddr l)))))))
(macros value (expand no-expand
macro-expansion for selectq replace
if while repeat let local incr decr
push pop mcons ncons xcons function
f:l q:l neq macros))
nil